home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / 3dcube.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-06-22  |  8.1 KB  |  288 lines
  1.  
  2. {$r-}
  3. program polygoned_cube;
  4. uses
  5.   crt;
  6. const
  7.   vidseg:word=$a000;
  8.   border:boolean=true;
  9.   divd:word=128;
  10.   dist=150;
  11.   point:array[0..7,0..2] of integer=(
  12.     (-30,-30,-30),(-30,-30,30),(30,-30,30),(30,-30,-30),
  13.     (-30, 30,-30),(-30, 30,30),(30, 30,30),(30, 30,-30));
  14.   planes:array[0..5,0..3] of byte=(
  15.     (0,4,5,1),(0,3,7,4),(0,1,2,3),(4,5,6,7),(7,6,2,3),(1,2,6,5));
  16. var
  17.   ctab:array[0..255] of integer;
  18.   stab:array[0..255] of integer;
  19.   polyz:array[0..5] of integer;
  20.   pind:array[0..5] of byte;
  21.   virscr:pointer;
  22.   virseg:word;
  23.   minx,miny,maxx,maxy:integer;
  24.  
  25. { -------------------------------------------------------------------------- }
  26.  
  27. procedure retrace; assembler; asm
  28.   mov dx,3dah; @vert1: in al,dx; test al,8; jz @vert1
  29.   @vert2: in al,dx; test al,8; jnz @vert2; end;
  30.  
  31. procedure setborder(col:byte); assembler; asm
  32.   xor ch,ch; mov cl,border; jcxz @out; mov dx,3dah; in al,dx
  33.   mov dx,3c0h; mov al,11h+32; out dx,al; mov al,col; out dx,al; @out: end;
  34.  
  35. procedure flip(src,dst:word); assembler; asm
  36.   push ds; mov ax,[dst]; mov es,ax; mov ax,[src]; mov ds,ax
  37.   xor si,si; xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;
  38.  
  39. procedure cls(lvseg:word); assembler; asm
  40.   mov es,[lvseg]; xor di,di; xor ax,ax; mov cx,320*200/2; rep stosw; end;
  41.  
  42. procedure setpal(c,r,g,b:byte); assembler; asm
  43.   mov dx,3c8h; mov al,[c]; out dx,al; inc dx; mov al,[r]
  44.   out dx,al; mov al,[g]; out dx,al; mov al,[b]; out dx,al; end;
  45.  
  46. function cosinus(i:byte):integer; begin cosinus:=ctab[i]; end;
  47. function sinus(i:byte):integer; begin sinus:=stab[i]; end;
  48.  
  49. { -------------------------------------------------------------------------- }
  50.  
  51. procedure horline(xb,xe,y:integer; c:byte); assembler;
  52. asm
  53.   mov bx,xb
  54.   mov cx,xe
  55.   cmp bx,cx
  56.   jb @skip
  57.   xchg bx,cx
  58.  @skip:
  59.   inc cx
  60.   sub cx,bx
  61.   mov es,virseg
  62.   mov ax,y
  63.   shl ax,6
  64.   mov di,ax
  65.   shl ax,2
  66.   add di,ax
  67.   add di,bx
  68.   mov al,c
  69.   shr cx,1
  70.   jnc @skip2
  71.   stosb
  72.  @skip2:
  73.   mov ah,al
  74.   rep stosw
  75.  @out:
  76. end;
  77.  
  78. function MaxI(A,B:Integer):Integer;
  79. inline(
  80. $58/                       {pop   ax       }
  81. $5B/                       {pop   bx       }
  82. $3B/$C3/                   {cmp   ax,bx    }
  83. $7F/$01/                   {jg    +1       }
  84. $93);                      {xchg  ax,bx    }
  85. function MinI(A,B:Integer):Integer;
  86. inline(
  87. $58/                       {pop   ax       }
  88. $5B/                       {pop   bx       }
  89. $3B/$C3/                   {cmp   ax,bx    }
  90. $7C/$01/                   {jl    +1       }
  91. $93);                      {xchg  ax,bx    }
  92. function InRangeI(value,min,max:integer):integer;
  93. inline(
  94. $59/                       {pop   cx  max  }
  95. $5B/                       {pop   bx  min  }
  96. $58/                       {pop   ax  val  }
  97. $3B/$C3/                   {cmp   ax,bx    }
  98. $7F/$03/                   {jg    +3       }
  99. $93/                       {xchg  ax,bx    }
  100. $Eb/$05/                   {jmp   +5       }
  101. $3B/$C1/                   {cmp   ax,cx    }
  102. $7C/$01/                   {jl    +1       }
  103. $91);                      {xchg  ax,cx    }
  104.  
  105.  
  106. procedure polygon( x1,y1, x2,y2, x3,y3, x4,y4 :integer; c:byte);
  107. var pos:array[0..199,0..1] of integer;
  108.   xdiv1,xdiv2,xdiv3,xdiv4:integer;
  109.   ydiv1,ydiv2,ydiv3,ydiv4:integer;
  110.   dir1,dir2,dir3,dir4:byte;
  111.   ly,gy,y,tmp,step:integer;
  112. begin
  113.   { determine highest and lowest point + vertical window checking }
  114.   ly:=MaxI(MinI(MinI(MinI(y1,y2),y3),y4),miny);
  115.   gy:=MinI(MaxI(MaxI(MaxI(y1,y2),y3),y4),maxy);
  116.  
  117.   if ly>maxy then exit;
  118.   if gy<miny then exit;
  119.  
  120.   { check directions (-1=down, 1=up) and calculate constants }
  121.   dir1:=byte(y1<y2); xdiv1:=x2-x1; ydiv1:=y2-y1;
  122.   dir2:=byte(y2<y3); xdiv2:=x3-x2; ydiv2:=y3-y2;
  123.   dir3:=byte(y3<y4); xdiv3:=x4-x3; ydiv3:=y4-y3;
  124.   dir4:=byte(y4<y1); xdiv4:=x1-x4; ydiv4:=y1-y4;
  125.  
  126.   y:=y1;
  127.   step:=dir1*2-1;
  128.   if y1<>y2 then begin
  129.     repeat
  130.       if InRangeI(y,ly,gy)=y then begin
  131.         tmp:=xdiv1*(y-y1) div ydiv1+x1;
  132.         pos[y,dir1]:=InRangeI(tmp,minx,maxx);
  133.       end;
  134.       inc(y,step);
  135.     until y=y2+step;
  136.   end
  137.   else begin
  138.     if (y>=ly) and (y<=gy) then begin
  139.       pos[y,dir1]:=InRangeI(x1,minx,maxx);
  140.     end;
  141.   end;
  142.  
  143.   y:=y2;
  144.   step:=dir2*2-1;
  145.   if y2<>y3 then begin
  146.     repeat
  147.       if InRangeI(y,ly,gy)=y then begin
  148.         tmp:=xdiv2*(y-y2) div ydiv2+x2;
  149.         pos[y,dir2]:=InRangeI(tmp,minx,maxx);
  150.       end;
  151.       inc(y,step);
  152.     until y=y3+step;
  153.   end
  154.   else begin
  155.     if (y>=ly) and (y<=gy) then begin
  156.       pos[y,dir2]:=InRangeI(x2,minx,maxx);
  157.     end;
  158.   end;
  159.  
  160.   y:=y3;
  161.   step:=dir3*2-1;
  162.   if y3<>y4 then begin
  163.     repeat
  164.       if InRangeI(y,ly,gy)=y then begin
  165.         tmp:=xdiv3*(y-y3) div ydiv3+x3;
  166.         pos[y,dir3]:=InRangeI(tmp,minx,maxx);
  167.       end;
  168.       inc(y,step);
  169.     until y=y4+step;
  170.   end
  171.   else begin
  172.     if (y>=ly) and (y<=gy) then begin
  173.       pos[y,dir3]:=InRangeI(x3,minx,maxx);
  174.     end;
  175.   end;
  176.  
  177.   y:=y4;
  178.   step:=dir4*2-1;
  179.   if y4<>y1 then begin
  180.     repeat
  181.       if InRangeI(y,ly,gy)=y then begin
  182.         tmp:=xdiv4*(y-y4) div ydiv4+x4;
  183.         pos[y,dir4]:=InRangeI(tmp,minx,maxx);
  184.       end;
  185.       inc(y,step);
  186.     until y=y1+step;
  187.   end
  188.   else begin
  189.     if (y>=ly) and (y<=gy) then begin
  190.       pos[y,dir4]:=InRangeI(x4,minx,maxx);
  191.     end;
  192.   end;
  193.  
  194.   for y:=ly to gy do horline(pos[y,0],pos[y,1],y,c);
  195. end;
  196.  
  197. { -------------------------------------------------------------------------- }
  198.  
  199. procedure quicksort(lo,hi:integer);
  200.  
  201. procedure sort(l,r:integer);
  202. var i,j,x,y:integer;
  203. begin
  204.   i:=l; j:=r; x:=polyz[(l+r) div 2];
  205.   repeat
  206.     while polyz[i]<x do inc(i);
  207.     while x<polyz[j] do dec(j);
  208.     if i<=j then begin
  209.       y:=polyz[i]; polyz[i]:=polyz[j]; polyz[j]:=y;
  210.       y:=pind[i]; pind[i]:=pind[j]; pind[j]:=y;
  211.       inc(i); dec(j);
  212.     end;
  213.   until i>j;
  214.   if l<j then sort(l,j);
  215.   if i<r then sort(i,r);
  216. end;
  217.  
  218. begin
  219.   sort(lo,hi);
  220. end;
  221.  
  222. { -------------------------------------------------------------------------- }
  223.  
  224. procedure rotate_cube;
  225. const xst=2; yst=3; zst=-2;
  226. var
  227.   xp,yp,z:array[0..7] of integer;
  228.   x,y,i,j,k:integer;
  229.   n,phix,phiy,phiz:byte;
  230. begin
  231.   phix:=0; phiy:=0; phiz:=0;
  232.   fillchar(xp,sizeof(xp),0);
  233.   fillchar(yp,sizeof(yp),0);
  234.   repeat
  235.     retrace;
  236.     setborder(5);
  237.     for n:=3 to 5 do
  238.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  239.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  240.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  241.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],0);
  242.     for n:=0 to 7 do begin
  243.       i:=(cosinus(phiy)*point[n,0]-sinus(phiy)*point[n,2]) div divd;
  244.       j:=(cosinus(phiz)*point[n,1]-sinus(phiz)*i) div divd;
  245.       k:=(cosinus(phiy)*point[n,2]+sinus(phiy)*point[n,0]) div divd;
  246.       x:=(cosinus(phiz)*i+sinus(phiz)*point[n,1]) div divd;
  247.       y:=(cosinus(phix)*j+sinus(phix)*k) div divd;
  248.       z[n]:=(cosinus(phix)*k-sinus(phix)*j) div divd;
  249.       xp[n]:=160+(-x*dist) div (z[n]-dist);
  250.       yp[n]:=100+(-y*dist) div (z[n]-dist);
  251.     end;
  252.     for n:=0 to 5 do begin
  253.       polyz[n]:=(z[planes[n,0]]+z[planes[n,1]]+z[planes[n,2]]+z[planes[n,3]]) div 4;
  254.       pind[n]:=n;
  255.     end;
  256.     quicksort(0,5);
  257.     for n:=3 to 5 do
  258.       polygon(xp[planes[pind[n],0]],yp[planes[pind[n],0]],
  259.               xp[planes[pind[n],1]],yp[planes[pind[n],1]],
  260.               xp[planes[pind[n],2]],yp[planes[pind[n],2]],
  261.               xp[planes[pind[n],3]],yp[planes[pind[n],3]],pind[n]+1);
  262.     inc(phix,xst); inc(phiy,yst); inc(phiz,zst);
  263.     setborder(0);
  264.     flip(virseg,vidseg);
  265.     setborder(0);
  266.   until keypressed;
  267. end;
  268.  
  269. { -------------------------------------------------------------------------- }
  270.  
  271. var i:word;
  272. begin
  273.   minx:=0; miny:=0; maxx:=319; maxy:=199;
  274.   asm mov ax,13h; int 10h; end;
  275.   getmem(virscr,64000);
  276.   virseg:=seg(virscr^);
  277.   cls(virseg);
  278.   for i:=0 to 5 do setpal(i+1,10+i*2,20+i*2,30+i*2);
  279.   for i:=0 to 255 do ctab[i]:=round(-cos(i*pi/128)*divd);
  280.   for i:=0 to 255 do stab[i]:=round(sin(i*pi/128)*divd);
  281.   rotate_cube;
  282.   freemem(virscr,64000);
  283.   textmode(lastmode);
  284. end.
  285.  
  286. { First polygon-routine, updated with Marius Ellen's routines,
  287.   only shorter and neater, not realy much faster... }
  288.